if (!require(plotly)) install.packages('plotly')
library(plotly)
if (!require(tidyverse)) install.packages('tidyverse')
library(tidyverse)
if (!require(readxl)) install.packages('readxl')
library(readxl)

Exercise 1

Insert any text here.

burden <- read_excel("Apartment List Data -- Cost Burden 2019.xlsx", skip = 1)
## New names:
## * `Total Renter Households` -> `Total Renter Households...3`
## * `Overall Cost Burden Rate` -> `Overall Cost Burden Rate...4`
## * `Moderate Cost Burden Rate` -> `Moderate Cost Burden Rate...5`
## * `Severe Cost Burden Rate` -> `Severe Cost Burden Rate...6`
## * `Number of Cost-Burdened Households` -> `Number of Cost-Burdened Households...7`
## * ...
burden <- select(burden, -12)

namelist <- c("N_Rent_Households",
              "Overall_Burden_Rate",
              "Moderate_Burden_Rate",
              "Severe_Burden_Rate",
              "N_Burden_Overall",
              "N_Burden_Moderate",
              "N_Burden_Severe",
              "Median_Rent",
              "Median_Renter_Income")

names(burden) <- c("Location",
                   "Type",
                   paste(namelist, "18", sep="_"),
                   paste(namelist, "17", sep="_"),
                   paste(namelist, "08", sep="_"),
                   paste(namelist, "change_17_18", sep="_"),
                   paste(namelist, "change_08_18", sep="_"))

myplot <- burden %>%
  filter(Type == "Metro" & Overall_Burden_Rate_18 > 0) %>%
  ggplot(aes(x=Overall_Burden_Rate_18, y=N_Burden_Overall_18)) +
    geom_point(aes(color=Overall_Burden_Rate_18)) +
    scale_y_log10(breaks = c(1000, 2000, 5000, 10000, 20000, 50000, 
                             100000, 200000, 500000, 1000000),
                labels = c("1000", "2K", "5K", "10K", "20K", "50K", 
                           "100K", "200K", "500K", "1M"),
                minor_breaks=NULL) +
    labs(title="THE U.S. CITIES WITH\nTHE BIGGEST COST BURDENS",
         subtitle=
           "Apartment List analyzed which cities have the worst income-to-rent ratios.",
         caption = "Source: Apartment List and Yahoo Finance") +
    xlab("OVERALL COST BURDEN RATE") +
    ylab("# OF COST BURDENED HOUSEHOLDS") +
    scale_color_gradient(low="yellow", high="red") +
    guides(color=FALSE) +
    theme(plot.background = element_rect(fill = "#1F0E42")) +
    theme(panel.background = element_rect(fill = "#1F0E42")) +
    theme(title = element_text(color = "white")) +
    theme(axis.text = element_text(color = "white")) +
    theme(plot.title = element_text(hjust=0.5, size = 25)) + 
    theme(plot.subtitle = element_text(hjust=0.5)) +
    scale_x_continuous(labels = scales::percent) +
    theme(panel.grid = element_line(color = "gray", size = 0.1))
## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.
myplot

Making the Graph Interactive

ggplotly(myplot) %>%
ggplot(aes(x=Overall_Burden_Rate_18, y=N_Burden_Overall_18, ids=Location))

ggplotly(myplot)
ggplotly(myplot, tooltip = "ids") %>%
ggplot(aes(x=Overall_Burden_Rate_18, y=N_Burden_Overall_18, ids=Location,
           text=paste("Burden Rate: ",Overall_Burden_Rate_18,"%")))

ggplotly(myplot, tooltip = c("ids", "text"))
myplot <- myplot + theme(plot.title = element_text(hjust=0.5, size = 16))
ggplotly(myplot, tooltip = c("ids", "text")) %>%
  layout(title = list(text = paste("THE U.S. CITIES WITH THE BIGGEST COST BURDENS",
                                    "<br>", "<sup>",
                                    "Apartment List analyzed which cities have the worst income-to-rent ratios.",
                                    "</sup>")))
LS0tDQp0aXRsZTogIkxhYiBOYW1lIg0KYXV0aG9yOiAiQXV0aG9yIE5hbWUiDQpkYXRlOiAiYHIgU3lzLkRhdGUoKWAiDQpvdXRwdXQ6IG9wZW5pbnRybzo6bGFiX3JlcG9ydA0KLS0tDQoNCmBgYHtyIGxvYWQtcGFja2FnZXMsIG1lc3NhZ2U9RkFMU0V9DQppZiAoIXJlcXVpcmUocGxvdGx5KSkgaW5zdGFsbC5wYWNrYWdlcygncGxvdGx5JykNCmxpYnJhcnkocGxvdGx5KQ0KaWYgKCFyZXF1aXJlKHRpZHl2ZXJzZSkpIGluc3RhbGwucGFja2FnZXMoJ3RpZHl2ZXJzZScpDQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCmlmICghcmVxdWlyZShyZWFkeGwpKSBpbnN0YWxsLnBhY2thZ2VzKCdyZWFkeGwnKQ0KbGlicmFyeShyZWFkeGwpDQpgYGANCg0KIyMjIEV4ZXJjaXNlIDENCg0KSW5zZXJ0IGFueSB0ZXh0IGhlcmUuDQoNCmBgYHtyIGNvZGUtY2h1bmstbGFiZWx9DQpidXJkZW4gPC0gcmVhZF9leGNlbCgiQXBhcnRtZW50IExpc3QgRGF0YSAtLSBDb3N0IEJ1cmRlbiAyMDE5Lnhsc3giLCBza2lwID0gMSkNCmJ1cmRlbiA8LSBzZWxlY3QoYnVyZGVuLCAtMTIpDQoNCm5hbWVsaXN0IDwtIGMoIk5fUmVudF9Ib3VzZWhvbGRzIiwNCiAgICAgICAgICAgICAgIk92ZXJhbGxfQnVyZGVuX1JhdGUiLA0KICAgICAgICAgICAgICAiTW9kZXJhdGVfQnVyZGVuX1JhdGUiLA0KICAgICAgICAgICAgICAiU2V2ZXJlX0J1cmRlbl9SYXRlIiwNCiAgICAgICAgICAgICAgIk5fQnVyZGVuX092ZXJhbGwiLA0KICAgICAgICAgICAgICAiTl9CdXJkZW5fTW9kZXJhdGUiLA0KICAgICAgICAgICAgICAiTl9CdXJkZW5fU2V2ZXJlIiwNCiAgICAgICAgICAgICAgIk1lZGlhbl9SZW50IiwNCiAgICAgICAgICAgICAgIk1lZGlhbl9SZW50ZXJfSW5jb21lIikNCg0KbmFtZXMoYnVyZGVuKSA8LSBjKCJMb2NhdGlvbiIsDQogICAgICAgICAgICAgICAgICAgIlR5cGUiLA0KICAgICAgICAgICAgICAgICAgIHBhc3RlKG5hbWVsaXN0LCAiMTgiLCBzZXA9Il8iKSwNCiAgICAgICAgICAgICAgICAgICBwYXN0ZShuYW1lbGlzdCwgIjE3Iiwgc2VwPSJfIiksDQogICAgICAgICAgICAgICAgICAgcGFzdGUobmFtZWxpc3QsICIwOCIsIHNlcD0iXyIpLA0KICAgICAgICAgICAgICAgICAgIHBhc3RlKG5hbWVsaXN0LCAiY2hhbmdlXzE3XzE4Iiwgc2VwPSJfIiksDQogICAgICAgICAgICAgICAgICAgcGFzdGUobmFtZWxpc3QsICJjaGFuZ2VfMDhfMTgiLCBzZXA9Il8iKSkNCg0KbXlwbG90IDwtIGJ1cmRlbiAlPiUNCiAgZmlsdGVyKFR5cGUgPT0gIk1ldHJvIiAmIE92ZXJhbGxfQnVyZGVuX1JhdGVfMTggPiAwKSAlPiUNCiAgZ2dwbG90KGFlcyh4PU92ZXJhbGxfQnVyZGVuX1JhdGVfMTgsIHk9Tl9CdXJkZW5fT3ZlcmFsbF8xOCkpICsNCiAgICBnZW9tX3BvaW50KGFlcyhjb2xvcj1PdmVyYWxsX0J1cmRlbl9SYXRlXzE4KSkgKw0KICAgIHNjYWxlX3lfbG9nMTAoYnJlYWtzID0gYygxMDAwLCAyMDAwLCA1MDAwLCAxMDAwMCwgMjAwMDAsIDUwMDAwLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgMTAwMDAwLCAyMDAwMDAsIDUwMDAwMCwgMTAwMDAwMCksDQogICAgICAgICAgICAgICAgbGFiZWxzID0gYygiMTAwMCIsICIySyIsICI1SyIsICIxMEsiLCAiMjBLIiwgIjUwSyIsIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgIjEwMEsiLCAiMjAwSyIsICI1MDBLIiwgIjFNIiksDQogICAgICAgICAgICAgICAgbWlub3JfYnJlYWtzPU5VTEwpICsNCiAgICBsYWJzKHRpdGxlPSJUSEUgVS5TLiBDSVRJRVMgV0lUSFxuVEhFIEJJR0dFU1QgQ09TVCBCVVJERU5TIiwNCiAgICAgICAgIHN1YnRpdGxlPQ0KICAgICAgICAgICAiQXBhcnRtZW50IExpc3QgYW5hbHl6ZWQgd2hpY2ggY2l0aWVzIGhhdmUgdGhlIHdvcnN0IGluY29tZS10by1yZW50IHJhdGlvcy4iLA0KICAgICAgICAgY2FwdGlvbiA9ICJTb3VyY2U6IEFwYXJ0bWVudCBMaXN0IGFuZCBZYWhvbyBGaW5hbmNlIikgKw0KICAgIHhsYWIoIk9WRVJBTEwgQ09TVCBCVVJERU4gUkFURSIpICsNCiAgICB5bGFiKCIjIE9GIENPU1QgQlVSREVORUQgSE9VU0VIT0xEUyIpICsNCiAgICBzY2FsZV9jb2xvcl9ncmFkaWVudChsb3c9InllbGxvdyIsIGhpZ2g9InJlZCIpICsNCiAgICBndWlkZXMoY29sb3I9RkFMU0UpICsNCiAgICB0aGVtZShwbG90LmJhY2tncm91bmQgPSBlbGVtZW50X3JlY3QoZmlsbCA9ICIjMUYwRTQyIikpICsNCiAgICB0aGVtZShwYW5lbC5iYWNrZ3JvdW5kID0gZWxlbWVudF9yZWN0KGZpbGwgPSAiIzFGMEU0MiIpKSArDQogICAgdGhlbWUodGl0bGUgPSBlbGVtZW50X3RleHQoY29sb3IgPSAid2hpdGUiKSkgKw0KICAgIHRoZW1lKGF4aXMudGV4dCA9IGVsZW1lbnRfdGV4dChjb2xvciA9ICJ3aGl0ZSIpKSArDQogICAgdGhlbWUocGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChoanVzdD0wLjUsIHNpemUgPSAyNSkpICsgDQogICAgdGhlbWUocGxvdC5zdWJ0aXRsZSA9IGVsZW1lbnRfdGV4dChoanVzdD0wLjUpKSArDQogICAgc2NhbGVfeF9jb250aW51b3VzKGxhYmVscyA9IHNjYWxlczo6cGVyY2VudCkgKw0KICAgIHRoZW1lKHBhbmVsLmdyaWQgPSBlbGVtZW50X2xpbmUoY29sb3IgPSAiZ3JheSIsIHNpemUgPSAwLjEpKQ0KbXlwbG90DQpgYGANCg0KIyMjIE1ha2luZyB0aGUgR3JhcGggSW50ZXJhY3RpdmUNCg0KYGBge3J9DQpnZ3Bsb3RseShteXBsb3QpICU+JQ0KZ2dwbG90KGFlcyh4PU92ZXJhbGxfQnVyZGVuX1JhdGVfMTgsIHk9Tl9CdXJkZW5fT3ZlcmFsbF8xOCwgaWRzPUxvY2F0aW9uKSkNCmdncGxvdGx5KG15cGxvdCkNCmdncGxvdGx5KG15cGxvdCwgdG9vbHRpcCA9ICJpZHMiKSAlPiUNCmdncGxvdChhZXMoeD1PdmVyYWxsX0J1cmRlbl9SYXRlXzE4LCB5PU5fQnVyZGVuX092ZXJhbGxfMTgsIGlkcz1Mb2NhdGlvbiwNCiAgICAgICAgICAgdGV4dD1wYXN0ZSgiQnVyZGVuIFJhdGU6ICIsT3ZlcmFsbF9CdXJkZW5fUmF0ZV8xOCwiJSIpKSkNCmdncGxvdGx5KG15cGxvdCwgdG9vbHRpcCA9IGMoImlkcyIsICJ0ZXh0IikpDQpteXBsb3QgPC0gbXlwbG90ICsgdGhlbWUocGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChoanVzdD0wLjUsIHNpemUgPSAxNikpDQpnZ3Bsb3RseShteXBsb3QsIHRvb2x0aXAgPSBjKCJpZHMiLCAidGV4dCIpKSAlPiUNCiAgbGF5b3V0KHRpdGxlID0gbGlzdCh0ZXh0ID0gcGFzdGUoIlRIRSBVLlMuIENJVElFUyBXSVRIIFRIRSBCSUdHRVNUIENPU1QgQlVSREVOUyIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiPGJyPiIsICI8c3VwPiIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiQXBhcnRtZW50IExpc3QgYW5hbHl6ZWQgd2hpY2ggY2l0aWVzIGhhdmUgdGhlIHdvcnN0IGluY29tZS10by1yZW50IHJhdGlvcy4iLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIjwvc3VwPiIpKSkNCmBgYA0KDQpgYGB7cn0NCg0KYGBg